home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / qbclrsel.zip / CSELDEMO.BAS next >
Encoding:
BASIC Source File  |  1992-02-23  |  26.7 KB  |  743 lines
  1. '***************************************************************************
  2. 'QUICK BASIC COLOR SELECT SUBROUTINE
  3. '***************************************************************************
  4. '
  5. 'A configurable subroutine to generate a color selection display
  6. 'for text-mode (SCREEN 0) screens in your program, enabling the user
  7. 'to select desired combination of foreground and background colors
  8. 'for any text display of your program.
  9. '
  10. 'Written by:        Peter R. Barnes
  11. '                   February, 1992
  12. '
  13. 'This routine is released to the public domain.  Feel free to modify it
  14. 'to suit your own individual style or requirements.  I did not make
  15. 'any serious effort to compose the most efficient or elegant code to
  16. 'perform the task, but it does the job.  Do with this what you will, just
  17. 'don't blame me for the results (unless they are great, of course).
  18. 'See the subroutine herein for documentation.  Merely cut and paste
  19. 'to use the subroutine in your program, or delete the code in this main
  20. 'module of the demo and compile to a separate .OBJ file which you can
  21. 'then link to any program.
  22. '
  23. 'If you use this code in a program which you offer for sale, please
  24. 'give credit where credit is due (namely, moi).  A mention of my name
  25. 'in your program's documentation would suffice.
  26. '
  27. 'NOTE THAT THIS ROUTINE DOES NOT CHECK THE STATUS OF THE BACKGROUND
  28. 'COLOR VIDEO DISPLAY MODE, WHICH CAN BE SET TO DISPLAY EITHER BLINKING
  29. 'BACKGROUND COLORS OR HIGH-INTENSITY BACKGROUND COLORS FOR ATTRIBUTES
  30. 'ABOVE 15; THE ROUTINE ASSUMES THE DEFAULT MODE, BLINKING, IS ENABLED.
  31. 'IF YOU WANT TO GUARANTEE ONE MODE OR THE OTHER EXISTS, YOU WILL HAVE
  32. 'TO USE Call Interrupt TO SET THE MODE VIA INTERRUPT 10, AX=&H1003,
  33. 'BL=0 FOR HIGH-INTENSITY, 1 FOR BLINKING.  AND THAT ONLY WORKS FOR SOME
  34. 'COLOR ADAPTERS, SOMETIMES; THERE REALLY IS NO SURE-FIRE WAY TO SET THE
  35. 'MODE FOR EVERY MONITOR/ADAPTER COMBINATION, NOR IS THERE EVEN ANY 100%
  36. 'RELIABLE WAY TO DETECT THE CURRENT MODE.  YOU MAY BE ABLE TO PEEK THE
  37. 'BIOS VIDEO STATUS WORD AT &H0040:&H0065, BIT 5, TO DETECT IT IN MOST
  38. 'CASES; THE BIT SHOULD BE SET WHEN BLINKING IS ENABLED, OFF WHEN
  39. 'HIGH -INTENSITY COLORS ARE AVAILABLE INSTEAD.
  40. '
  41. 'Or better yet, use one of the many good add-on libraries available to
  42. 'Quick Basic programmers (such as PBCLONE, the Cadillac of the bunch)
  43. 'to detect and/or set the mode.  There are also many PD routines, usually
  44. 'in Assembler form, available to accomplish this function.
  45. '
  46. '***************************************************************************
  47. '***************************************************************************
  48. '***************************************************************************
  49. '
  50. 'To use this routine in your program, include the following DECLARE
  51. 'statement at the beginning of the main module of your program:
  52. '
  53. 'DECLARE SUB QBCLRSEL (Title1$, Title2$, InitFClr%, InitBClr%,_
  54. '       BlinkSel%, CValsOn%, fc%, bc%, Attr%)
  55. '
  56. 'In your program, call the routine with the following statement:
  57. '
  58. 'QBCLRSEL Title1$, Title2$, InitFClr%, InitBClr%, BlinkSel%, CValsOn%,_
  59. '       fc%, bc%, Attr%
  60. '
  61. 'See the demo code below for an example.
  62. '
  63. '***************************************************************************
  64. 'Inputs passed to the routine:
  65. '***************************************************************************
  66. '
  67. '   Title1$         This is a string of up to 78 characters which
  68. '                   will be displayed, centered on the top screen
  69. '                   line, as a title for the color selection process.
  70. '                   If the string passed is empty (""), then a default
  71. '                   title "Select Your Desired Color" will be used; if
  72. '                   the string passed is "NOTITLE", then the top line
  73. '                   will not be displayed. The colors for this line
  74. '                   are fixed.
  75. '
  76. '   Title2$         This is a string of up to 78 characters which
  77. '                   will be displayed, centered on the second screen
  78. '                   line, as a subtitle for the color selection process.
  79. '                   If the string passed is empty (""), then a default
  80. '                   title "Current Color Selection" will be used; if
  81. '                   the string passed is "NOSUBTITLE", then this line
  82. '                   will not be displayed.  The colors for this line
  83. '                   will change to the current color selection indicated
  84. '                   as the user moves around the selection window.
  85. '
  86. '   InitFClr%       An integer value, ranging from 0 to 31, designating
  87. '                   the initial, or default, foreground color.  The color
  88. '                   selection routine will begin with this value framed
  89. '                   for selection; pressing ESCAPE at any time will return
  90. '                   the current color selection to this value.  Values
  91. '                   from 0-15 are normal; values of 16-31 set blinking
  92. '                   colors.
  93. '
  94. '   InitBClr%       An integer value, ranging from 0 to 7, designating
  95. '                   the initial, or default, background color.  The color
  96. '                   selection routine will begin with this value framed
  97. '                   for selection; pressing ESCAPE at any time will return
  98. '                   the current color selection to this value.
  99. '
  100. '   BlinkSel%       Switch to enable/disable selection of blinking
  101. '                   foreground colors.  Any non-zero integer value
  102. '                   will enable Blinking selection.  Default mode is
  103. '                   no blink selection.  When blink selection is disabled,
  104. '                   the corresponding blinking color status display
  105. '                   is suppressed.
  106. '
  107. '   CValsOn%        Switch to enable/disable display of the current
  108. '                   foreground and background color value numbers on
  109. '                   the color status line of the screen.  Any non-zero
  110. '                   integer value will enable status display.  Default
  111. '                   mode is no color value display.  When value display
  112. '                   is disabled, the corresponding color value status
  113. '                   display is suppressed.
  114. '
  115. '
  116. '***************************************************************************
  117. 'Outputs from the routine:
  118. '***************************************************************************
  119. '
  120. '
  121. '   fc%             An integer value from 0-31 for the foreground color
  122. '                   selected by the user.  Values from 16-31 are blinking
  123. '                   modes of the corresponding 0-15 values.
  124. '
  125. '   bc%             An integer value from 0-7 for the background color
  126. '                   selected by the user.
  127. '
  128. '   Attr%           An integer value for the screen color attribute of
  129. '                   the foreground/background color combination selected.
  130. '
  131. '
  132. '***************************************************************************
  133. '
  134. 'During the color selection process, the bottom line of the screen will
  135. 'display user help information, indicating the keys available for moving
  136. 'the selection frame.  The ESCAPE key will be displayed, in the default
  137. 'color combination if visible (i.e. FG <> BG), as the key to return to
  138. 'default values; the ENTER key will always be displayed as the key for
  139. 'selection of a color combination.  In the Blinking color selection
  140. 'routine, the Page Up key will be indicated to return to the color
  141. 'selection routine at the color combination currently displayed.
  142. '
  143. '
  144. '***************************************************************************
  145. '***************************************************************************
  146. '***************************************************************************
  147. '
  148. 'A (very simple) Demo for QBCLRSEL subroutine -- one subroutine call
  149. 'does it all!
  150. '
  151. 'You can run this source code file from the QB environment, or run the
  152. 'stand-alone .EXE file included with this file.
  153. '
  154.  
  155. DECLARE SUB QBCLRSEL (Title1$, Title2$, InitFClr%, InitBClr%, BlinkSel%, CValsOn%, fc%, bc%, Attr%)
  156. DEFINT A-Z
  157.  
  158. 'we will start with blink selection and color value displays enabled
  159.  
  160. BlinkSel = 1                    'switch allows selecting blinking colors
  161. CValsOn = 1                     'switch allows display of color values
  162.  
  163. InitFClr = 10                   'set initial color selection
  164. InitBClr = 4
  165.  
  166. Title1$ = " QBCLRSEL Color Selection Demo "     'or whatever
  167. Title2$ = " Screen Text Colors "                'ditto
  168.  
  169. begin:                                                                     
  170.  
  171. QBCLRSEL Title1$, Title2$, InitFClr%, InitBClr%, BlinkSel%, CValsOn%, fc%, bc%, Attr%
  172. '
  173. 'That's all it takes to get the color selection, the rest of this demo
  174. 'is just window dressing!
  175. '
  176. '
  177. CLS                 'display the colors selected
  178. COLOR fc, bc
  179. PRINT " Color Selection is: Foreground "; fc; " Background "; bc;
  180. PRINT " Attribute "; Attr
  181. PRINT
  182. PRINT "Press a key..."
  183.  
  184. SLEEP
  185.  
  186. COLOR 7, 0
  187. CLS
  188.  
  189. PRINT
  190. INPUT "Make Another Color Selection"; AC$
  191. IF UCASE$(AC$) = "Y" THEN                   'if yes, make the next set of
  192. IF fc > 15 THEN                             'default colors be the colors
  193.         InitFClr = fc - 16                  'selected this time, but
  194.         ELSE                                'we must subtract the blinking
  195.         InitFClr = fc                       'part of the foreground value
  196.     END IF
  197.     InitBClr = bc
  198.    
  199.     INPUT "Activate Blink Selection"; AB$
  200.     IF UCASE$(AB$) = "Y" THEN               'activate blink selection
  201.         BlinkSel = 1
  202.         ELSE
  203.         BlinkSel = 0
  204.     END IF
  205.  
  206.  
  207.     INPUT "Activate Color Value Display"; CVD$
  208.     IF UCASE$(CVD$) = "Y" THEN                  'activate color values
  209.         CValsOn = 1
  210.         ELSE
  211.         CValsOn = 0
  212.     END IF
  213.    
  214.     GOTO begin                          'play it again, Sam
  215.  
  216. END IF
  217.  
  218. END         'of another awesome demonstration of modern computing power
  219.  
  220. SUB QBCLRSEL (Title1$, Title2$, InitFClr%, InitBClr%, BlinkSel%, CValsOn%, fc%, bc%, Attr%)
  221.  
  222. '***************************************************************************
  223. 'QUICK BASIC COLOR SELECT SUBROUTINE
  224. '***************************************************************************
  225. '
  226. '
  227. DEFINT A-Z                      'default to integers for all variables
  228.  
  229.  
  230. SCREEN 0
  231.  
  232. IF Title1$ = "" THEN                            'if a title string is not
  233.     Title1$ = " Select Your Desired Color "     'passed to the routine, this
  234.     ELSEIF Title1$ = "NOTITLE" THEN             'sets defaults
  235.     Title1$ = ""
  236. END IF
  237.  
  238. IF Title2$ = "" THEN                            'ditto for subtitle
  239.     Title2$ = " Current Color Selection "
  240.     ELSEIF Title2$ = "NOSUBTITLE" THEN
  241.     Title2$ = ""
  242. END IF
  243.  
  244. MaxRows% = 7                    '8 Background Colors
  245. MaxCols% = 15                   '16 Foreground Colors
  246. REDIM RowVal(MaxRows%)          'initialize frame location arrays
  247. REDIM ColumnVal(MaxCols%)       'as dynamic arrays
  248.  
  249. COLOR 7, 0                      'set color to clear screen
  250. CLS                             'to black background
  251.  
  252. IF LEN(Title1$) THEN
  253.     IF LEN(Title1$) < 79 THEN               'set location for Title
  254.         T1loc = (79 - (LEN(Title1$))) / 2   'and center it
  255.         ELSE
  256.         Title1$ = LEFT$(Title1$, 78)        'truncate if longer than
  257.         T1loc = 1                           '78 characters
  258.     END IF
  259. END IF
  260.  
  261. IF LEN(Title2$) THEN
  262.     IF LEN(Title2$) < 79 THEN               'set location for subtitle
  263.         T2loc = (79 - (LEN(Title2$))) / 2   'same way
  264.         ELSE
  265.         Title2$ = LEFT$(Title2$, 78)
  266.         T2loc = 1
  267.     END IF
  268. END IF
  269.  
  270. IF BlinkSel THEN                'set starting column location of the sample
  271.     stloc = 9                   'text string display, at left if both
  272.     ELSEIF CValsOn THEN         'blink and value displays enabled, further
  273.     stloc = 20                  'right if just values enabled, centered
  274.     ELSE                        'if neither enabled
  275.     stloc = 31
  276. END IF
  277.  
  278. FOR y = 0 TO 7                  'get and store selection frame location array
  279.     RowVal(y) = 4 + (y * 2)     'values for rows
  280. NEXT
  281.  
  282. FOR x = 0 TO 15                 'and columns
  283.     ColumnVal(x) = 6 + (x * 4)
  284. NEXT
  285.  
  286. FOR bg = 0 TO 7                 'build and display color selection chart
  287.     CurRow = RowVal(bg) + 1
  288.     FOR fg = 0 TO 15
  289.       CurColumn = ColumnVal(fg) + 1
  290.       LOCATE CurRow, CurColumn
  291.       COLOR fg, bg: PRINT "Txt";
  292.     NEXT fg
  293. NEXT bg
  294.  
  295. IF LEN(Title1$) THEN            'if a title is passed,
  296.     COLOR 4, 3                  'print the title
  297.     LOCATE 1, T1loc
  298.     PRINT Title1$
  299. END IF
  300.  
  301. COLOR 7, 0                      'display selection window around
  302.                                 'first color selection
  303.                               
  304.                                 'make our selection window frame
  305.  
  306. tl$ = CHR$(213)                 'frame characters ╒
  307. tm$ = CHR$(205)                 '                 ═
  308. tr$ = CHR$(184)                 '                 ╕
  309. bm$ = CHR$(205)
  310. bl$ = CHR$(212)                 '                 ╘
  311. br$ = CHR$(190)                 '                 ╛
  312. ml$ = CHR$(179)                 '                 │
  313. mr$ = CHR$(179)                 '
  314.  
  315.                                 'assemble the strings
  316.                                 'for color selection cell frame
  317.  
  318. tlin$ = tl$ + tm$ + tm$ + tm$ + tr$     'top line of frame
  319. blin$ = bl$ + bm$ + bm$ + bm$ + br$     'bottom line of frame
  320.  
  321.                               
  322.                                 'assemble the strings
  323.                                 'for standard/blink selection frame
  324.  
  325. tmblnk$ = ""                    'erase any previous strings
  326. bmblnk$ = ""
  327.  
  328. FOR j = 1 TO 19
  329.     tmblnk$ = tmblnk$ + tm$             'top line of frame
  330.     bmblnk$ = bmblnk$ + bm$             'bottom line of frame
  331. NEXT
  332.  
  333. tlinblnk$ = tl$ + tmblnk$ + tr$         'add corners to frame lines
  334. blinblnk$ = bl$ + bmblnk$ + br$
  335.  
  336.  
  337. tlclr$ = "     "                'erase strings for color selection frame
  338. blclr$ = "     "
  339.  
  340. tlbclr$ = SPACE$(21)            'erase strings for standard/blink
  341. blbclr$ = SPACE$(21)            'selection frame
  342.  
  343.                                 'initialize help line strings
  344.  
  345. Row24CS$ = " Crsr Up Dn Rt Lt PgUp PgDn  Tab ShTab  Home End "
  346. Row24BS$ = "    Crsr    Rt Lt           Tab  ShTab         "
  347.  
  348. DoClrSelect:                    'start the color selection routine
  349.  
  350. fc = InitFClr                   'set initial color for foreground color
  351. bc = InitBClr                   'set initial color for background color
  352.                              
  353.  
  354. DoSelectAgain:                  're-entry point from blink select
  355.  
  356.                                 'locate frame at first selection
  357.  
  358. pr = RowVal(bc)                 'print row at location passed to routine
  359. pc = ColumnVal(fc)              'print column same way
  360.  
  361. COLOR 10, 0                     'print sample color bar line
  362.  
  363. LOCATE 22, stloc - 2
  364. PRINT ">                 <";    'bracket the standard text display
  365. IF BlinkSel THEN                'and the blinking text, if enabled
  366.     LOCATE 22, 51
  367.     PRINT ">                 <"
  368. END IF
  369.  
  370. IF CValsOn THEN                 'if color value display enable switch
  371.     LOCATE 22, stloc + 20       'is set, then print display legends
  372.     PRINT "Fgnd:";
  373.     LOCATE 22, stloc + 31
  374.     PRINT "Bgnd:";
  375. END IF
  376.  
  377. HelpLine$ = Row24CS$            'display help line
  378. Row24X$ = ""                    'no PgUp prompt
  379. GOSUB helplin
  380.  
  381. GOSUB samplin                   'print color sample text display
  382.  
  383. GOSUB valprnt                   'print current color values if switch enabled
  384.  
  385. DO                              'loop for selecting color
  386.  
  387.     LOCATE pr, pc               'print the frame--
  388.     PRINT tlin$;                    'top line
  389.     LOCATE pr + 1, pc
  390.     PRINT ml$;                      'middle left
  391.     LOCATE , pc + 4
  392.     PRINT mr$;                      'middle right
  393.     LOCATE pr + 2, pc
  394.     PRINT blin$;                    'bottom line
  395.  
  396.     GOSUB keyget                'get key pressed
  397.                                 'returns value kp, ASC code of key pressed
  398.  
  399.     IF kp <> 13 THEN            'if not ENTER key, then we are going to
  400.         GOSUB erasfrm           'move the frame, so we can erase the frame
  401.     END IF                      'in the current location
  402.  
  403.     SELECT CASE kp              'find out which key was pressed
  404.                                 'and adjust frame location parameters pr,pc
  405.  
  406.                                 'if keypress was ENTER, this section
  407.                                 'does nothing
  408.  
  409.         CASE 77                 'right arrow
  410.       
  411.             IF pc < 66 THEN     'if not at end of row
  412.                 pc = pc + 4     'go to next column location in the row
  413.                 fc = fc + 1     'which increments foreground color value
  414.                 ELSE
  415.                 pc = 6          'else go back to beginning of row
  416.                 fc = 0
  417.             END IF
  418.  
  419.         CASE 75                 'left arrow
  420.                               
  421.             IF pc > 6 THEN      'opposite way way for other direction arrow
  422.                 pc = pc - 4
  423.                 fc = fc - 1
  424.                 ELSE
  425.                 pc = 66
  426.                 fc = 15
  427.             END IF
  428.  
  429.         CASE 72                 'up arrow
  430.       
  431.             IF pr > 4 THEN      'same as above, only up and down
  432.                 pr = pr - 2     'changing background colors
  433.                 bc = bc - 1
  434.                 ELSE
  435.                 pr = 18
  436.                 bc = 7
  437.             END IF
  438.  
  439.         CASE 80                 'down arrow
  440.       
  441.             IF pr < 18 THEN
  442.                 pr = pr + 2
  443.                 bc = bc + 1
  444.                 ELSE
  445.                 pr = 4
  446.                 bc = 0
  447.             END IF
  448.  
  449.         CASE 71                 'home
  450.       
  451.             pr = 4: pc = 6      'back to first cell
  452.             fc = 0: bc = 0      'black on black
  453.  
  454.         CASE 79                 'end
  455.       
  456.             pr = 18: pc = 66    'go to last cell
  457.             fc = 15: bc = 7
  458.  
  459.         CASE 9                  'right tab
  460.       
  461.             pc = 66             'go to end of current row
  462.             fc = 15
  463.  
  464.         CASE 15                 'shift tab
  465.       
  466.             pc = 6              'go to beginning of current row
  467.             fc = 0
  468.   
  469.         CASE 73                 'page up
  470.       
  471.             pr = 4              'go to top of current column
  472.             bc = 0
  473.   
  474.         CASE 81                 'page down
  475.       
  476.             pr = 18             'go to bottom of current column
  477.             bc = 7
  478.  
  479.  
  480.         CASE 27                'esc returns to initial color values
  481.  
  482.             pr = RowVal(InitBClr)           'print row at location
  483.                                             'passed to routine
  484.           
  485.             pc = ColumnVal(InitFClr)        'print column same way
  486.  
  487.             fc = InitFClr                   'set initial color
  488.                                             'for foreground color
  489.           
  490.             bc = InitBClr                   'set initial color
  491.                                             'for background color
  492.  
  493.     END SELECT
  494.   
  495.                                 'now we have our keypress
  496.  
  497.     GOSUB samplin               'update text sample line
  498.    
  499.     GOSUB valprnt               'print color values if switch enabled
  500.  
  501. LOOP UNTIL kp = 13              'do it again, until ENTER key pressed
  502.  
  503. '*********************************************************************
  504. 'blink/non-blink color selection
  505.  
  506. GOSUB erasfrm                   'ENTER key selected, erase color
  507.                                 'select frame
  508.  
  509.                                 'if blink selection enabled,
  510.                                 'print the standard/blink selection frame
  511.  
  512. IF BlinkSel THEN                'select standard/blink characters
  513.                                 'if switch is set
  514.  
  515.     Oldfc = fc                  'store the selected colors
  516.     Oldbc = bc                  'in case we start over
  517.  
  518.     pr = 21: pc = 6: kp = 0     'initial selection frame on standard
  519.  
  520.     DO                          'loop to select
  521.  
  522.         LOCATE pr, pc           'print standard/blink selection frame
  523.         PRINT tlinblnk$;
  524.         LOCATE pr + 1, pc
  525.         PRINT ml$;
  526.         LOCATE , pc + 20
  527.         PRINT mr$;
  528.         LOCATE pr + 2, pc
  529.         PRINT blinblnk$;
  530.  
  531.         HelpLine$ = Row24BS$    'print the standard/blink help line
  532.         Row24X$ = " PgUp "      'add Page Up key to return to color
  533.         GOSUB helplin           'selection with current colors as defaults
  534.   
  535.         GOSUB keyget            'get user keypress
  536.       
  537.         IF kp <> 13 THEN        'if not ENTER key, then we are
  538.             GOSUB erasfrmblnk   'going to move the frame
  539.         END IF                  'so we can erase the frame
  540.                                 'in the current location
  541.  
  542.  
  543.                                 'find out which key was pressed
  544.                                 'and adjust frame location parameters pr,pc
  545.       
  546.         SELECT CASE kp              'only allow right/left cursor, ESC,
  547.                                     'tab keys, page up, and ENTER
  548.  
  549.             CASE IS = 77, 9         'right arrow or right tab
  550.      
  551.                 IF pc < 50 THEN     'same general way as above
  552.                     pc = 50
  553.                     fc = fc + 16
  554.                     ELSE
  555.                     pc = 6
  556.                     fc = fc - 16
  557.                 END IF
  558.  
  559.             CASE IS = 75, 15        'left arrow or shift tab
  560.                              
  561.                 IF pc > 6 THEN
  562.                     pc = 6
  563.                     fc = fc - 16
  564.                     ELSE
  565.                     pc = 50
  566.                     fc = fc + 16
  567.                 END IF
  568.  
  569.             CASE IS = 27            'ESCape key
  570.  
  571.                 GOTO DoClrSelect    'start over from beginning
  572.  
  573.             CASE IS = 73            'Page up key
  574.  
  575.                 fc = Oldfc
  576.                 bc = Oldbc
  577.               
  578.                 GOTO DoSelectAgain  'go back to choose another color
  579.  
  580.         END SELECT
  581.  
  582.     GOSUB valprnt               'update the current color value display
  583.   
  584.     LOOP UNTIL kp = 13          'if not ENTER key, do it again
  585.  
  586. END IF                          'all of this loop is skipped if blink
  587.                                 'selection was not enabled
  588.  
  589. '*********************************************************************
  590. 'At this point we are done selecting the color combination
  591.  
  592.  
  593. Attr = (bc * 16) + fc           'determine attribute for selected
  594.                                 'color combination
  595.  
  596.                                 'and we are done with the subroutine
  597.  
  598. GOTO Done                       'Beam us up, Scotty
  599.  
  600.  
  601. '**************************************************************************
  602. '**************************************************************************
  603. 'Local subroutines used in color selection program.
  604. 'Yes, that's right -- GOSUBs will be used in YOUR perfectly-coded program!!
  605. 'Who cares?  It works -- PB
  606. '**************************************************************************
  607. '**************************************************************************
  608. '
  609. '
  610. '**************************************************************************
  611. 'local subroutine to erase current frame by printing spaces over the
  612. 'current frame display
  613. '**************************************************************************
  614.  
  615. erasfrm:
  616.  
  617. LOCATE pr, pc: PRINT tlclr$;
  618. LOCATE pr + 1, pc: PRINT " "; : LOCATE , pc + 4: PRINT " ";
  619. LOCATE pr + 2, pc: PRINT blclr$;
  620. RETURN
  621.  
  622.  
  623. '**************************************************************************
  624. 'local subroutine prints current color values in display boxes in line 22
  625. '**************************************************************************
  626.  
  627. valprnt:
  628.  
  629. IF CValsOn THEN                     'converts color values to
  630.                                     'printable strings
  631.  
  632.     ft$ = " " + LTRIM$(RTRIM$(STR$(fc)))
  633.     bt$ = " " + LTRIM$(RTRIM$(STR$(bc)))
  634.  
  635.     COLOR 7, 0                      'first print the backgrounds
  636.     LOCATE 22, stloc + 26           'to erase any old values
  637.     PRINT "   ";
  638.     LOCATE 22, stloc + 37
  639.     PRINT "   ";
  640.     COLOR 1, 7                      'then print the values
  641.     LOCATE 22, stloc + 26
  642.     PRINT ft$;
  643.     LOCATE 22, stloc + 37
  644.     PRINT bt$;
  645. END IF
  646.  
  647. COLOR 7, 0                          'restore black background
  648. RETURN
  649.  
  650.  
  651. '**************************************************************************
  652. 'local subroutine to get next keypress and return value in kp
  653. '**************************************************************************
  654.  
  655. keyget:
  656.  
  657. ks$ = ""                            'clear out any old keypress code
  658.  
  659. DO                                  'get user keypress
  660.     ks$ = INKEY$
  661. LOOP UNTIL ks$ > ""
  662.  
  663. ks$ = RIGHT$(ks$, 1)                'get keyscan code, less the ASC(0)
  664. kp = ASC(ks$)                       'if ctl/alt key combination
  665.  
  666. RETURN
  667.  
  668.  
  669. '**************************************************************************
  670. 'local subroutine to erase current standard/blink frame
  671. '**************************************************************************
  672.  
  673. erasfrmblnk:
  674.  
  675. COLOR 7, 0
  676. LOCATE pr, pc: PRINT tlbclr$;
  677. LOCATE pr + 1, pc: PRINT " "; : LOCATE , pc + 20: PRINT " ";
  678. LOCATE pr + 2, pc: PRINT blbclr$;
  679.  
  680. RETURN
  681.  
  682.  
  683. '**************************************************************************
  684. 'local subroutine to update sample line
  685. '**************************************************************************
  686.  
  687. samplin:
  688.  
  689. COLOR fc, bc                'reprint subtitle in current colors
  690.  
  691. IF LEN(Title2$) THEN
  692.     LOCATE 3, T2loc
  693.     PRINT Title2$
  694. END IF
  695.  
  696. LOCATE 22, stloc            'stloc = 9 for blink, 32 no blink
  697. PRINT " Standard Text ";
  698. IF BlinkSel THEN
  699.     LOCATE 22, 53
  700.     COLOR fc + 16, bc
  701.     PRINT " Blinking Text ";
  702. END IF
  703.  
  704. RETURN
  705.  
  706.  
  707. '**************************************************************************
  708. 'local subroutine to print help line
  709. '**************************************************************************
  710.  
  711. helplin:
  712.  
  713. LOCATE 24, 4
  714. COLOR 15, 5
  715. PRINT HelpLine$;                'print available keys help message
  716.  
  717. IF LEN(Row24X$) THEN            'print PgUp if necessary
  718.     COLOR Oldfc, Oldbc
  719.     PRINT Row24X$;
  720. END IF
  721.  
  722. IF InitFClr <> InitBClr THEN    'if default fg,bg colors are not equal
  723.     COLOR InitFClr, InitBClr    'then print ESC help message
  724.     ELSE                        'in default colors
  725.     COLOR 0, 7                  'else print in black on white
  726. END IF
  727. PRINT " Esc ";
  728.  
  729. COLOR 1, 2                      'print ENTER help message
  730. PRINT " ENTER Selects ";
  731. COLOR 7, 0
  732.  
  733. RETURN
  734.  
  735.  
  736. '**************************************************************************
  737. '**************************************************************************
  738.  
  739. Done:                           'Back to the Starship ENTERPRISE
  740.  
  741. END SUB
  742.  
  743.